{ ================================================================= }
{                                                                   }
{  PFREPT - report printing procedures and functions                }
{                                                                   }
{    VERSION: PC6.1d                                                }
{    CREATED: 15:06:39  11/11/1985                                  }
{    REVISED: 8/27/93 - longer printcodes                           }
{             9/4/93 -  removed Page & Line, revised NewPage to use }
{                       FF instead of WriteLn's                     }
{                                                                   }
{ ================================================================= }

{ ------------------------------------------------------------------------ }
{ Copyright 1982 - 1993 James S Stone, dba Project Control Systems         }
{                                                                          }
{ Licensed under the Apache License, Version 2.0 (the "License");          }
{ you may not use this file except in compliance with the License.         }
{ You may obtain a copy of the License at                                  }
{                                                                          }
{ http://www.apache.org/licenses/LICENSE-2.0                               }
{                                                                          }
{ Unless required by applicable law or agreed to in writing, software      }
{ distributed under the License is distributed on an "AS IS" BASIS,        }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and      }
{ limitations under the License.                                           }
{ ------------------------------------------------------------------------ }

{$R-}                                   {Range checking off}
{$B+}                                   {Boolean complete evaluation on}
{$S+}                                   {Stack checking on}
{$I+}                                   {I/O checking on}
{$N-}                                   {No numeric coprocessor}
{$V-}                                   {Relaxed var string checking}

unit PfRept;

interface

uses
  Crt,
  Dos,
  Printer,
  PfComm;


procedure PfReportMenu;


  {===========================================================================}

implementation



  { pfrept -  print project reports }

  procedure PfReportMenu;

  label Quit;

  const
    PRINTCODELEN = 78;                  { print code length }

  type
    PrintCodes = String[PRINTCODELEN];  { was 4 }
    StType = record
               Cash : CashType          { subtotal values }
             end;
    LineType = (ItemLine, Subtotal, Escalation, BaseTot, Total);
    FreqType = (Monthly, Annual);
    FreqStrType = array[FreqType] of String[8];
    FormType = (Incr, AnnCumul, TotCumul);
    FormStrType = array[FormType] of String[13];
    EscType = (Base, Escalated, Separate);
    EscStrType = array[EscType] of String[9];
(*    AdjustType = (Page, Line);
*)
  const
    MARGIN = 10;                    { margin at top + bottom of page }
    FreqStr : FreqStrType = ('MONTHLY/', 'ANNUAL/');
    FormStr : FormStrType = ('INCREMENTAL  ', 'YEARLY-CUMUL ', 'TOTAL-CUMUL  ');
    ESCSTR : EscStrType = ('BASE     ', 'ESCALATED', 'SEPARATE ');

  var
    ShiftIn,
    ShiftOut,
    ShiftNorm : PrintCodes;
    LastPer : 1..MAXPER;                { last non-zero period }
    RepDate : String[TITLEN];           { report date }
    FirstPer,                           { on page }
    PageNumber,                         { page }
    StartYr,                            { start year [1..10] of monthly report }
    EndYr,                              { end year [1..10] of monthly report }
    LineNum,                            { line # }
{   PageLen,    in PFCOMM }             { page length }
    Item : Integer;                     { cost account currently being printed }
    BaseBuf,                            { base total }
    Totbuf,                             { bottom line total }
    EscLine : CashType;                 { bottom escalation line }
    St : packed array[1..MAXSUB] of StType; { subtotal values }
    Pause : Boolean;                    { pause at end of page }
    Freq : FreqType;
    Form : FormType;
    EscMode : EscType;
    IList : Iptr;
    CodeFile,                           { printer codes }
    OutFile : Text;                     { output file }
    OutName : String[8];                { output filename }


    { dosdate  make the date equal to the DOS date }
    procedure DosDate;
    type
      MonType = array[1..12] of String[9];
    const
      Mon : MonType = ('January', 'February', 'March', 'April', 'May', 'June',
                      'July', 'August', 'September', 'October', 'November', 'December');
    var
      Temp : String[4];
      Reg : Registers;
    begin
      Reg.AX := $2A00;
      Msdos(Dos.Registers(Reg));
      RepDate := Mon[Hi(Reg.DX)];
      Str(Lo(Reg.DX):2, Temp);
      RepDate := RepDate+' '+Temp+', ';
      Str(Reg.CX:4, Temp);
      RepDate := RepDate+Temp;
    end;                                { dosdate }



    { dispheader  -  display header info on screen }
    procedure DispHeader;
    begin
      ClrBlok(1, 6, 80, 7);
      DataColor(Normal);
      GotoXY(1, 6);
      Write('TITLE 1: ', Pbuf.TitLn1);
      GotoXY(40, 6);
      Write('TITLE 2: ', Pbuf.TitLn2);
      GotoXY(1, 7);
      Write('COMPANY: ', Pbuf.Company);
      GotoXY(40, 7);
      Write('DATE   : ', RepDate);
    end;                                { dispheader }



    { dispitem  -  display items of subtotals }
    procedure DispItem(I : Integer);
    var
      IList : Iptr;
      J : Integer;
    begin
      J := 1;
      IList := Iroot;
      while (I <> J) do begin
        IList := IList^.Next;
        J := J+1;
      end;
      Write(IList^.Info.Ides);
    end;                                { dispitem }



    { dispsub  -  display subtotals }
    procedure DispSub;
    var
      I : Integer;
    begin
      ClrBlok(1, 9, 80, 17);
      DataColor(Normal);
      for I := 1 to MAXSUB do begin
        GotoXY(1, I+8);
        Write('SUBTOTAL ', I, ': ');
        if Pbuf.Stinfo[I].On then
          with Pbuf.Stinfo[I] do begin
            Write(Desc);
            GotoXY(30, I+8);
            Write(': ');
            DispItem(First);
            GotoXY(49, I+8);
            Write('TO');
            GotoXY(52, I+8);
            DispItem(Last)
          end
        else
          Write('[ OFF ]');
      end;                              { for }
    end;                                { dispsub }



    { disptype  -  display report type }
    procedure DispType;
    begin
      GotoXY(1, 19);
      DataColor(Normal);
      Write('TYPE: ', FreqStr[Freq], FormStr[Form]);
    end;                                { disptype }



    { dispesc  -  display escalation mode }
    procedure DispEsc;
    begin
      GotoXY(30, 19);
      DataColor(Normal);
      Write('MODE: ', ESCSTR[EscMode]);
    end;                                { dispesc }



    { disprange  -  display report range }
    procedure DispRange;
    begin
      GotoXY(57, 19);
      DataColor(Normal);
      ClrEol;
      Write('RANGE: ', Pbuf.Start+StartYr-1, ' TO ', Pbuf.Start+EndYr-1);
    end;                                { disprange }



    { ExpandPrintCode - expand print code to editable format }
    function ExpandPrintCode (S : PrintCodes) : String;
    var
      I : Integer;
      s1, DispStr : String;
    begin
      I := 1;
      DispStr := '';
      while (I <= Length(S)) do begin
        if not (S[I] in ['!'..'~']) then begin
          Str(Ord(S[I]), s1);
          s1 := '\' + s1
        end else
          s1 := S[I];
        DispStr := DispStr + s1;
        Inc(I);
      end;
      ExpandPrintCode := DispStr;
    end;



    { dispcode  -  display print code }
    procedure DispCode(S : PrintCodes);
    const
      MaxDispLen = 16;                  { display only 16 chars }
    var
      I : Integer;
      s1, DispStr : String;
    begin
      DispStr := ExpandPrintCode(S);
      if Length(DispStr) > MaxDispLen then begin
        Delete(DispStr, MaxDispLen - 2, Length(DispStr) - MaxDispLen + 3);
        DispStr := DispStr + '...'
      end;
    writeln(DispStr);
    end;                                { dispcode }



    { dispsetup  -  display printer setup info }
    procedure DispSetup;
    begin
      ClrBlok(1, 21, 80, 22);
      DataColor(Normal);
      GotoXY(1, 21);
      Write('EXPAND: ');
      DispCode(ShiftOut);
      GotoXY(30, 21);
      Write('COMP: ');
      DispCode(ShiftIn);
      GotoXY(56, 21);
      Write('NORMAL: ');
      DispCode(ShiftNorm);
      GotoXY(1, 22);
      Write('LENGTH: ');
      Write(PageLen);
      GotoXY(56, 22);
      Write('OUTPUT: ');
      if Length(OutName) = 0 then
        Write('PRINTER')
      else
        Write(OutName+'.TXT');
    end;                                { dispsetup }



    { getheader  -  get report header info }
    procedure GetHeader;
    begin
      HelpNum := 38;
      Menu[0].Brief := '1';
      Menu[0].Full := 'Change title line 1';
      Menu[1].Brief := '2';
      Menu[1].Full := 'Change title line 2';
      Menu[2].Brief := 'Company';
      Menu[2].Full := 'Change company name';
      Menu[3].Brief := 'Date';
      Menu[3].Full := 'Change report date';
      Choice := MenuChoice(3, Ioff);
      C := #0;
      State(Lbl);
      case Choice of
        0 : LastCh := GetString('Enter title line 1:', Pbuf.TitLn1, TITLEN, C);
        1 : LastCh := GetString('Enter title line 2:', Pbuf.TitLn2, TITLEN, C);
        2 : LastCh := GetString('Enter company name:', Pbuf.Company, TITLEN, C);
        3 : LastCh := GetString('Enter report date:', RepDate, TITLEN, C);
      end;                              { case }
      DispHeader;
    end;                                { getheader }



    { getsub  -  get the subtotal name and range for the number chosen }
    procedure GetSub;
    label 1, 2, Quit;
    const
      SUBMENU : String[16] = 'Define subtotal ';
    var
      Snum : 1..MAXSUB;                 { subtotal number }
      Descrip : String[IDESLEN];        { subtotal description }
      I : Integer;
    begin
      HelpNum := 39;
      if Hitem < 2 then begin
        Error('Can''t subtotal.');
        goto Quit;
      end;

      Menu[0].Brief := '1';
      Menu[0].Full := SUBMENU+'1';
      Menu[1].Brief := '2';
      Menu[1].Full := SUBMENU+'2';
      Menu[2].Brief := '3';
      Menu[2].Full := SUBMENU+'3';
      Menu[3].Brief := '4';
      Menu[3].Full := SUBMENU+'4';
      Menu[4].Brief := '5';
      Menu[4].Full := SUBMENU+'5';
      Menu[5].Brief := '6';
      Menu[5].Full := SUBMENU+'6';
      Menu[6].Brief := '7';
      Menu[6].Full := SUBMENU+'7';
      Menu[7].Brief := '8';
      Menu[7].Full := SUBMENU+'8';
      Menu[8].Brief := '9';
      Menu[8].Full := SUBMENU+'9';
      Choice := MenuChoice(8, Ioff);
      if Choice = 27 then
        goto Quit;

      Snum := Choice+1;

      { toggle subtotal on/off }
1:    with Pbuf.Stinfo[Snum] do begin
        On := not(On);
        if not(On) then
          goto Quit;

2:      State(Point);
        FillChar(ItemGroup, SizeOf(ItemGroup), 0);
        DisplayIlist(GROUPON);
        LastCh := GetGroup(ItemGroup, RANGEONLY);
        if LastCh = Ord(ESC) then
          goto 1;

        First := 0;
        for I := 1 to Hitem do          { get start and end of range of S/T }
          if (First = 0) and ItemGroup[I] then begin
            First := I;                 { start of range }
            Last := I                   { initial end of range }
          end else if (First > 0) and ItemGroup[I] then
            Last := I;                  { final end of range }

        Descrip := '';
        C := #0;
        State(Lbl);
        LastCh := GetString('Enter subtotal description', Descrip, IDESLEN, C);
        if LastCh = Ord(ESC) then
          goto 2;

        Desc := Descrip;
      end;                              { with }

Quit:
      ClrBlok(1, 4, 80, 25);
      GotoXY(38, 4);                    { display report screen }
      Write('REPORT');
      GotoXY(1, 4);
      WriteBar(80, True);
      DispHeader;
      DispSub;
      DispType;
      DispEsc;
      DispRange;
      DispSetup;
    end;                                { getsub }



    { gettype  -  get report type }
    procedure GetType;
    begin
      HelpNum := 40;
      repeat
        Menu[0].Brief := 'Annual';
        Menu[0].Full := 'Report annual values';
        Menu[1].Brief := 'Monthly';
        Menu[1].Full := 'Report monthly values with annual subtotals';
        Menu[2].Brief := 'Incremental';
        Menu[2].Full := 'Report values in incremental format';
        Menu[3].Brief := 'Year-Cumul';
        Menu[3].Full := 'Report values in yearly cumulative format';
        Menu[4].Brief := 'Total-Cumul';
        Menu[4].Full := 'Report values in total cumulative format';
        Menu[5].Brief := 'Quit';
        Menu[5].Full := 'Return to Report menu';
        Choice := MenuChoice(5, Ioff);
        case Choice of
          0 : Freq := Annual;
          1 : Freq := Monthly;
          2 : Form := Incr;
          3 : Form := AnnCumul;
          4 : Form := TotCumul;
          27,
          5 : Exit;
        end;
        DispType;
      until False = True;
    end;                                { gettype }



    { getescmode  -  get escalation mode }
    procedure GetEscMode;
    begin
      HelpNum := 41;
      Menu[0].Brief := 'Base';
      Menu[0].Full := 'Report items as Edited  --  without escalation';
      Menu[1].Brief := 'Escalated';
      Menu[1].Full := 'Calculate escalation and include in each item';
      Menu[2].Brief := 'Separate';
      Menu[2].Full := 'Calculate escalation and include "below the line"';
      Choice := MenuChoice(2, Ioff);
      if Choice in [1, 2] then
        SetUpEsc(EscBuf, IfNeeded);
      case Choice of
        0 : EscMode := Base;
        1 : EscMode := Escalated;
        2 : EscMode := Separate;
      end;                              { case }
      DispEsc;
    end;                                { getescmode }



    { getrange  -  get range of years to be included in report }
    procedure GetRange;
    label 1, Quit;
    var
      Y : Integer;



      function SelectYr(S : Integer; var Y : Integer) : Integer;
      var
        I : Integer;
      begin
        DataColor(Normal);
        for I := 1 to (MAXPERYR-S+1) do begin
          PutAt(I, 1, 7, 0, 2);
          Write(Pbuf.Start+I+S-2:6);
        end;
        Y := 1;
        SelectYr := ArrowSelect(Y, 1, MAXPERYR-S+1, 1, 7, 0, 2);
      end;                              { selectyr }



    begin                               { getrange }
      HelpNum := 42;
      State(Value);
1:    Message('Select first year in report');
      LastCh := SelectYr(1, Y);
      if LastCh = Ord(ESC) then
        goto Quit
      else
        StartYr := Y;
      if StartYr = MAXPERYR then begin
        EndYr := StartYr;               { can only be a 1 yr report! }
        goto Quit;
      end;

      Message('Select last year in report');
      LastCh := SelectYr(StartYr, Y);
      if LastCh = Ord(ESC) then
        goto 1
      else
        EndYr := StartYr+Y-1;
Quit:
      DispRange;
    end;                                { getrange }



    { getsetup  -  get printer set up codes }
    procedure GetSetup;


      { getpcode  -  get printer code }
      procedure GetPcode(var Pc : PrintCodes);
      var
        Pstr : String;                  { input string, was 16 }
        I, v, Code : Integer;           { counter, value, error code }
        S3 : String[3];                 { string for holding number }
        S1 : String[1];                 { string for character }
      begin
        C := #0;
        Pstr := ExpandPrintCode(Pc);
        LastCh := GetString('Enter printer codes (example ''\027AB\27CD'')', Pstr, PRINTCODELEN, C);
        if C = CR then begin            { conversion }
          Pc := '';
          while (Length(Pstr) > 0) do begin   { parse Pstr }
            if Pstr[1] = '\' then begin
              Delete(Pstr, 1, 1);             { delete \ }
              I:= 1;
              S3 := '';
              while (I <= 3) and (Pstr[1] in ['0'..'9']) do begin
                S3 := S3 + Pstr[1];
                Delete(Pstr, 1, 1);
                Inc(I)
              end;
              Val(S3, v, Code);         { convert S3 to v }
              if v < 256 then begin
                S1 := Chr(v);             { convert v to S1 }
                Pc := Pc + S1
              end
            end else begin
              Pc := Pc + Pstr[1];
              Delete(Pstr, 1, 1)
            end;
          end;                          { while }
        end;                            { if }
      end;                              { getpcode }



    begin                               { getsetup }
      HelpNum := 43;
      repeat
        State(Menus);
        Menu[0].Brief := 'Expanded';
        Menu[0].Full := 'Set printer code for expanded print';
        Menu[1].Brief := 'Compressed';
        Menu[1].Full := 'Set printer code for compressed print';
        Menu[2].Brief := 'Normal';
        Menu[2].Full := 'Set printer code for normal print';
        Menu[3].Brief := 'Length';
        Menu[3].Full := 'Set the number of lines per page';
        Menu[4].Brief := 'Quit';
        Menu[4].Full := 'Leave the Setup menu and return to the Report menu';
        Choice := MenuChoice(4, Ioff);
        C := #0;
        State(Value);
        case Choice of
          0 : GetPcode(ShiftOut);
          1 : GetPcode(ShiftIn);
          2 : GetPcode(ShiftNorm);
          3 : begin
                HelpNum := 44;
                LastCh := GetInt('Enter number of lines per page',
                                 PageLen, 3, C);
              end;
        end;                            { case }
        DispSetup;
      until Choice in [4, 27];

      State(Wait);
      Assign(CodeFile, PCODENAME);
      {$I-}
      Rewrite(CodeFile);
      if IoResult = 0 then begin
        WriteLn(CodeFile, ShiftIn);
        WriteLn(CodeFile, ShiftOut);
        WriteLn(CodeFile, ShiftNorm);
        WriteLn(CodeFile, PageLen);
        Close(CodeFile)
      end else
        Error('Error in saving print code file.');
      {$I+}
    end;                                { getsetup }



    { getoutput  -  get output filename }
    procedure GetOutput;
    label 1;
    const
      GOODSET : set of Char = ['A'..'Z', '0'..'9', '$', '&',
      '#', '@', '!', '%', '''', '`', '(', ')', '-', '{', '}', '_', '/'];
    var
      I : Integer;
    begin
1:    C := #0;
      LastCh := GetString('Enter output filename (blank for printer)',
                          OutName, 8, C);
      if LastCh = Ord(ESC) then
        OutName := ''
      else if Length(OutName) > 0 then
        for I := 1 to Length(OutName) do begin
          OutName[I] := Upcase(OutName[I]);
          if not(OutName[I] in GOODSET) then begin
            Error('Illegal character ['+OutName[I]+'] in name.');
            goto 1
          end;                          { if }
        end;                            { for }
      DispSetup;
    end;                                { getoutput }



    { getprintcodes  -  get printer shiftin and shiftout codes }
    procedure GetPrintCodes;
    begin
      Assign(CodeFile, PCODENAME);
      {$I-}
      Reset(CodeFile);
      if IoResult = 0 then begin
        {$I+}
        ReadLn(CodeFile, ShiftIn);
        ReadLn(CodeFile, ShiftOut);
        ReadLn(CodeFile, ShiftNorm);
        ReadLn(CodeFile, PageLen);
        Close(CodeFile)
      end else begin
        FillChar(ShiftIn, SizeOf(ShiftIn), 0);
        FillChar(ShiftOut, SizeOf(ShiftOut), 0);
        FillChar(ShiftNorm, SizeOf(ShiftNorm), 0);
        PageLen := 66;
      end;
    end;                                { getprintcodes }



    { getlastper  -  determine the last year in which costs occur }
    function GetLastPer(Freq : FreqType) : Integer;
    begin
      IList := Iroot;
      LastPer := StartYr*12;
      while IList <> nil do begin       { determine pages }
        Ibuf := IList^.Info;
        for Per := MINPER to MAXPER do
          if (Abs(Ibuf.Icash[Per]) > 0.1) and (Per > LastPer) then
            LastPer := Per;
        IList := IList^.Next;
      end;                              { while }
      if ((LastPer > (EndYr*12)) and (Freq = Monthly)) then
        LastPer := EndYr*12
      else
        LastPer := ((LastPer-1) div 12+1)*12;
      GetLastPer := LastPer;
    end;                                { getlastper }

    {$I-}

    { outbad  -  check output to file to see that all's OK }
    function OutBad : Boolean;
    var
      Ioerr : Integer;
    begin
      Ioerr := IoResult;
      if (Ioerr > 0) and (Length(OutName) > 0) then
        Error('Error in writing report  -  Diskette may be full.');
      OutBad := (Ioerr > 0);
    end;                                { outbad }



(*    { adjustpage  -  adjust printer position }
    procedure AdjustPage(How : AdjustType);
    var
      I : Integer;
    begin
      if PrintChk then
        case How of                     { always to printer }
          Page : begin
                   for I := LineNum to PageLen do
                     WriteLn(Lst);
                   LineNum := 1;
                 end;
          Line : begin
                   WriteLn(Lst);
                   LineNum := 1;
                 end;
        end;
    end;                                { adjustpage }

  *)

    { newpage  -  add lines to outfile to top of page }
    procedure NewPage;
    var
      I : Integer;
    begin
      if Length(OutName) = 0 then       { printer }
        Write(OutFile, FF)
      else
        for I := LineNum to PageLen do
          WriteLn(OutFile);
      LineNum := 1;
    end;                                { newpage }



    { headannual  -  print unique annual report header }
    procedure HeadAnnual;
    var
      I : Integer;
    begin
      Write(OutFile, 'ITEM    DESCRIPTION ');
      for I := Pbuf.Start to (Pbuf.Start+MAXPERYR-1) do
        Write(OutFile, '      ', I:YRLEN);
      WriteLn(OutFile, '     TOTAL');
      LineNum := 12;
    end;                                { headannual }



    { headmonthly -  print unique monthly report header }
    procedure HeadMonthly;
    var
      Mdes : String[3];
      I, Year : Integer;
    begin
      Write(OutFile, Rpt(' ', 20));
      Year := (FirstPer-1) div 12+Pbuf.Start;
      I := FirstPer;
      repeat
        Write(OutFile, '    ', Year:YRLEN);
        I := I+1;
      until (I > LastPer) or (I > FirstPer+11);
      WriteLn(OutFile);
      Write(OutFile, 'ITEM    DESCRIPTION ');
      I := FirstPer;
      repeat
        Mdes := Copy(MSTR, (I-1) mod 12*3+1, 3);
        Write(OutFile, '     ', Mdes);
        I := I+1;
      until (I > LastPer) or (I > FirstPer+11);
      if Form in [Incr, AnnCumul] then
        WriteLn(OutFile, '  YR TOT  TODATE')
      else
        WriteLn(OutFile, '  TODATE');
      LineNum := 13;
    end;                                { headmonthly }



    { checkheader  -  check line number, page feed and print header if req'd }
    procedure CheckHeader(Freq : FreqType);
    begin
      if (LineNum > 0) and (LineNum < PageLen-MARGIN) then
        LineNum := LineNum+1
      else begin
        LineNum := LineNum+1;
        PageNumber := PageNumber+1;
        if LineNum >= PageLen-MARGIN then
          NewPage;
        if Pause then begin
          Message('Press any key to continue');
          Continue;
        end;
        if Length(OutName) = 0 then     { to printer only }
          Write(OutFile, ShiftIn);
        WriteLn(OutFile, Rpt(' ', 120), 'Page ', FirstPer div 12+1,
                Chr(PageNumber+64));
        if Length(OutName) = 0 then
          Write(OutFile, ShiftOut);
        WriteLn(OutFile, Pbuf.TitLn1);
        if Length(OutName) = 0 then
          Write(OutFile, ShiftOut);
        WriteLn(OutFile, Pbuf.TitLn2);
        WriteLn(OutFile);
        if Length(OutName) = 0 then
          Write(OutFile, ShiftIn);
        WriteLn(OutFile, Pbuf.Name, Rpt(' ', 132-Length(Pbuf.Name+
                                                        RepDate)), RepDate);
        WriteLn(OutFile, Pbuf.Company, Rpt(' ', 114-Length(Pbuf.Company)),
                'PlanFlow');
        Write(OutFile, 'TYPE: ', FreqStr[Freq], FormStr[Form], Rpt(' ', 31));
        Write(OutFile, 'MODE: ', ESCSTR[EscMode], Rpt(' ', 42));
        Write(OutFile, 'CUTOFF: ');
        if Pbuf.Cutoff = 0 then
          WriteLn(OutFile, 'None')
        else
          WriteLn(OutFile, Copy(MSTR, (Pbuf.Cutoff-1) mod 12*3+1, 3),
                  ' ', (Pbuf.Cutoff-1) div 12+Pbuf.Start);
        WriteLn(OutFile, Rpt('=', 132));
        case Freq of
          Annual : HeadAnnual;
          Monthly : HeadMonthly;
        end;                            { case }
        WriteLn(OutFile, Rpt('=', 132));
        WriteLn(OutFile);
      end;                              { if }
    end;                                { checkheader }



    {processitem  -  build item, subtotals, escalation line, and total }
    procedure ProcessItem(Freq : FreqType);
    var
      EndPer : 1..MAXPER;
      I : Integer;
    begin
      case Freq of
        Annual : EndPer := LastPer;
        Monthly : EndPer := FirstPer+11;
      end;

      { if escalated, item escalation on, & not separate escalation }
      if (EscMode = Escalated) and (not Ibuf.EscFlag) then
        for Per := MINPER to EndPer do  { calc escalation up to endper }
          if Per > Pbuf.Cutoff then     { put escalation in item }
            Ibuf.Icash[Per] := RRound(Ibuf.Icash[Per]*EscBuf[Per]);

      for Per := FirstPer to EndPer do begin { for current page range }
        for I := 1 to MAXSUB do         { do subtotals }
          with Pbuf.Stinfo[I] do
            if On and (First <= Item) and (Last >= Item) then
              St[I].Cash[Per] := St[I].Cash[Per]+Ibuf.Icash[Per];
        Cost := 0.0;                    { for totbuf to be OK }
        if EscMode = Separate then begin
          BaseBuf[Per] := RRound(BaseBuf[Per]+Ibuf.Icash[Per]);
          if (not Ibuf.EscFlag) and (Per > Pbuf.Cutoff) then begin
            Cost := RRound(Ibuf.Icash[Per]*EscBuf[Per]
                           -Ibuf.Icash[Per]); { escalation, only }
            EscLine[Per] := RRound(EscLine[Per]+Cost)
          end                           { if }
        end;
        Totbuf[Per] := RRound(Totbuf[Per]+Ibuf.Icash[Per]+Cost);
      end;                              { for per }

    end;                                { processitem }



    {printmonthly  -  print costs by month for one year }
    procedure PrintMonthly;
    var
      YearTotal,
      Todate : Real;
    begin
      YearTotal := 0.0;
      Todate := 0.0;
      for Per := MINPER to (FirstPer+11) do begin
        Todate := RRound(Todate+Ibuf.Icash[Per]);
        if Per >= FirstPer then begin
          YearTotal := RRound(YearTotal+Ibuf.Icash[Per]);
          if (Form = Incr) then
            Write(OutFile, ' ', RToS(Ibuf.Icash[Per], CLEN+1))
          else if Form = AnnCumul then
            Write(OutFile, ' ', RToS(YearTotal, CLEN+1))
          else
            Write(OutFile, ' ', RToS(Todate, CLEN+1))
        end;                            { if }
      end;                              { for }
      if Form <> TotCumul then
        WriteLn(OutFile, ' ', RToS(YearTotal, CLEN+1), ' ', RToS(Todate, CLEN+1))
      else
        WriteLn(OutFile, ' ', RToS(Todate, CLEN+1));
    end;                                { printmonthly }



    { printannual  -  print annual costs for entire duration }
    procedure PrintAnnual;
    var
      Y : 0..MAXPERYR;
      M : 1..12;
      Total : Real;
    begin
      Total := 0.0;
      for Y := 0 to (MAXPERYR-1) do begin
        Cost := 0.0;
        for M := 1 to 12 do
          Cost := RRound(Cost+Ibuf.Icash[Y*12+M]);
        Total := RRound(Total+Cost);
        if Form = Incr then
          Write(OutFile, '   ', RToS(Cost, CLEN+1))
        else
          Write(OutFile, '   ', RToS(Total, CLEN+1))
      end;                              { for y }
      WriteLn(OutFile, '   ', RToS(Total, CLEN+1));
    end;                                { printannual }



    {printline  -  print cost item, subtotal, and total }
    procedure PrintLine(LineStatus : LineType; Freq : FreqType);
    begin
      if (Freq = Annual) or (FirstPer >= StartYr*12-11) then begin
        if LineStatus = BaseTot then begin
          Ibuf.Icash := BaseBuf;
          Ibuf.Ides := 'Base Total'
        end else if LineStatus = Escalation then begin
          Ibuf.Icash := EscLine;
          Ibuf.Ides := 'Escalation'
        end else if LineStatus = Total then begin
          Ibuf.Icash := Totbuf;
          Ibuf.Ides := 'Project Total'
        end;
        if LineStatus in [Subtotal, BaseTot, Escalation, Total] then
          Write(OutFile, '    ')
        else                            { linestatus := item or subtotal }
          Write(OutFile, Item:3, ' ');
        Write(OutFile, Ibuf.Ides, Rpt(' ', IDESLEN-Length(Ibuf.Ides)));
        case Freq of
          Monthly : PrintMonthly;
          Annual : PrintAnnual;
        end;
        if LineStatus = Total then
          Inc(LineNum)
        else
          CheckHeader(Freq);
      end;                              { if }
    end;                                { printline }



    { printsubtotals  -  print subtotal if last incl item just printed }
    procedure PrintSubtotals(Freq : FreqType);
    var
      I : Integer;
      LineNeeded,
      EndOfSub : Boolean;
    begin
      LineNeeded := False;
      EndOfSub := False;
      if (Freq = Annual) or (FirstPer >= StartYr*12-11) then
        for I := 1 to MAXSUB do         { print subs }
          with Pbuf.Stinfo[I] do
            if On and (Last = Item) then begin { a subtotal is done }
              WriteLn(OutFile, Rpt('-', 132));
              Inc(LineNum);
              Ibuf.Ides := Desc;
              Ibuf.Icash := St[I].Cash;
              PrintLine(Subtotal, Freq);
              WriteLn(OutFile);
              CheckHeader(Freq);
              EndOfSub := True
            end else if On and (Item = First-1) then
              LineNeeded := True;       { a subtotal follows }
      if LineNeeded and not EndOfSub then begin
        WriteLn(OutFile);
        CheckHeader(Freq);
      end;
    end;                                { printsubtotals }



    { printescline  -  if escalation separate, print base total & escalation }
    procedure PrintEscLine(Freq : FreqType);
    begin                               { if annual report or monthly report in range to print }
      if (Freq = Annual) or (FirstPer >= StartYr*12-11) then begin
        WriteLn(OutFile, Rpt('-', 132));
        Inc(LineNum);
        PrintLine(BaseTot, Freq);
        WriteLn(OutFile);
        CheckHeader(Freq);
        PrintLine(Escalation, Freq);
      end;                              { if }
    end;                                { printescline }



    { report  -  print all the items according to the desired frequency }
    procedure Report;
    label Stop;
    begin                               { report }
      if Length(OutName) > 0 then
        Assign(OutFile, DataPath+OutName+'.TXT')
      else if PrintChk then
        Assign(OutFile, 'PRN')
      else
        Exit;
      Rewrite(OutFile);
      if Ioresult > 0 then
        Exit;
      Pause := False;
      if Length(OutName) = 0 then begin
        State(Print);
        Message('Press <sp> to pause between pages, <Esc> to stop')
      end else begin
        State(Wait);
        Message('')
      end;
      FillChar(BaseBuf, SizeOf(BaseBuf), 0);
      FillChar(Totbuf, SizeOf(Totbuf), 0);
      FillChar(EscLine, SizeOf(EscLine), 0);
      FillChar(St, SizeOf(St), 0);

      LastPer := GetLastPer(Freq);
      LineNum := 0;                     { to print header w/o page advance }
      FirstPer := MINPER;
      repeat                            { do page 1,2,... }
        PageNumber := 0;                { i.e. A }
        Item := 0;
        if (FirstPer >= StartYr*12-11) or (Freq = Annual) then
          CheckHeader(Freq);
        if OutBad then Exit;
        IList := Iroot;
        while (IList <> nil) do begin
          if KeyPressed and (Length(OutName) = 0) then begin
            C := Getc;
            if C = ' ' then
              Pause := True
            else if C = ESC then
              goto Stop;
          end;
          Ibuf := IList^.Info;          { print all items }
          Item := Item+1;
          ProcessItem(Freq);
          PrintLine(ItemLine, Freq);
          PrintSubtotals(Freq);
          if OutBad then Exit;
          IList := IList^.Next;
        end;                            { while }
        if EscMode = Separate then
          PrintEscLine(Freq);
        { if annual report, or monthly in range to print }
        if OutBad then Exit;
        if (Freq = Annual) or (FirstPer >= StartYr*12-11) then begin
          WriteLn(OutFile, Rpt('=', 132));
          if OutBad then Exit;
          Inc(LineNum)
        end;
        PrintLine(Total, Freq);
        if OutBad then Exit;
        if (FirstPer >= StartYr*12-11) or (Freq = Annual) then begin
          NewPage;
          LineNum := 0                  { reset for header printout }
        end;
        case Freq of
          Monthly : FirstPer := FirstPer+12;
          Annual : FirstPer := LastPer+1;
        end;
      until FirstPer > LastPer;

Stop:
      if Length(OutName) = 0 then
        Write(OutFile, ShiftNorm);
      Close(OutFile);
    end;                                { report }

    {$I+}

  begin                                 { printproject }
    GetPrintCodes;
    DosDate;                            { initialization }
    Freq := Monthly;
    Form := Incr;
    EscMode := Base;
    StartYr := 1;
    EndYr := MAXPERYR;
    OutName := '';
    ClrBlok(1, 4, 80, 25);
    GotoXY(38, 4);                      { display report screen }
    DataColor(Normal);
    Write('REPORT');
    GotoXY(1, 4);
    WriteBar(80, True);
    DispHeader;
    DispSub;
    DispType;
    DispEsc;
    DispRange;
    DispSetup;
    repeat
      LineNum := 1;
      HelpNum := 37;
      State(Menus);
      Menu[0].Brief := 'Header';
      Menu[0].Full := 'Change the 2 Title lines, Company, and Date';
      Menu[1].Brief := 'Subtotals';
      Menu[1].Full := 'Define the report subtotals';
      Menu[2].Brief := 'Type';
      Menu[2].Full := 'Select Monthly or Annual / Incremental or Cumulative report';
      Menu[3].Brief := 'Mode';
      Menu[3].Full :=
      'Report Base, Escalated, or escalation-Separate values';
      Menu[4].Brief := 'Range';
      Menu[4].Full := 'Select the range of years included in report';
      Menu[5].Brief := 'Codes';
      Menu[5].Full := 'Set printer codes and page length for all reports';
      Menu[6].Brief := 'Output';
      Menu[6].Full := 'Output to printer or filename';
(*      Menu[7].Brief := 'Page';
      Menu[7].Full := 'Advance printer to top of next page';
      Menu[8].Brief := 'Line';
      Menu[8].Full := 'Advance printer one line';
*)      Menu[7].Brief := 'Go';
      Menu[7].Full := 'Print report';
      Menu[8].Brief := 'Quit';
      Menu[8].Full := 'Leave the Report menu and return to the Main menu';
      Choice := MenuChoice(8, Ioff);
      case Choice of
        0 : GetHeader;
        1 : GetSub;
        2 : GetType;
        3 : GetEscMode;
        4 : GetRange;
        5 : GetSetup;
        6 : GetOutput;
(*        7 : AdjustPage(Page);
        8 : AdjustPage(Line);
*)        7 : if Hitem = 0 then
              Error('No items to report.')
            else
              Report;
        27,
        8 : goto Quit;
      end;                              { case }
    until False = True;
Quit:
    DisplayIlist(GROUPOFF)
  end;                                  { pfrept }
end.
